home *** CD-ROM | disk | FTP | other *** search
/ Shareware Grab Bag / Shareware Grab Bag.iso / 090 / pctj8505.arc / PWRI.PAS < prev    next >
Pascal/Delphi Source File  |  1986-09-14  |  2KB  |  62 lines
  1. FUNCTION RLSCAN(X: REAL; N: INTEGER): REAL;
  2.  
  3. {This function scans the positive exponent N from right to left
  4. to determine a sequence of multiplications and squarings that
  5. produce X (real) to the power N (integer) in a near-minimum
  6. number of multiplications.  It is used as a function in the
  7. function PWRI, listed below.  The algorithm is Algorithm A, page
  8. 442, Vol. 2, 2nd Ed. of Knuth: "The Art of Computer Programming:
  9. Seminumerical Algorithms", Addison-Wesley, 1981.}
  10.  
  11. VAR   Y,Z: REAL;
  12.         O: BOOLEAN;
  13.      BIGN: INTEGER;
  14.  
  15. BEGIN
  16.  
  17.   BIGN := N; Y := 1.0; Z := X;
  18.   WHILE BIGN > 0 DO
  19.     BEGIN
  20.       O := ODD(BIGN);
  21.       BIGN := BIGN DIV 2;
  22.       IF O THEN
  23.         BEGIN
  24.           Y := Y*Z;
  25.           RLSCAN := Y
  26.         END;
  27.       Z := Z*Z
  28.     END;
  29.  
  30. END;
  31.  
  32.  
  33. FUNCTION PWRI(X: REAL; N: INTEGER): REAL;
  34.  
  35. {PWRI performs the tests necessary to eliminate the non-
  36. computable cases of finding X (real) to the power N (integer).
  37. It calls upon function RLSCAN to do the actual computation
  38. after it has, for example, replaced a negative exponent by
  39. a positive one (it does a reciprocation after return from
  40. RLSCAN in that case).}
  41.  
  42. BEGIN
  43.  
  44.   IF (N>0) THEN PWRI := RLSCAN(X,N)
  45.   ELSE IF (X<>0.0) AND (N<0) THEN
  46.     BEGIN
  47.       N := -N;
  48.       PWRI := 1.0/RLSCAN(X,N)
  49.     END
  50.   ELSE IF (N=0) AND (X<>0) THEN PWRI := 1.0
  51.   ELSE IF (N=0) AND (X=0) THEN
  52.     BEGIN
  53.       WRITELN('0 to the 0 power. Halt.');
  54.       HALT
  55.     END
  56.   ELSE IF (N<0) AND (X=0) THEN
  57.     BEGIN
  58.       WRITELN('Division by zero. Halt.');
  59.       HALT
  60.     END
  61.  
  62. END;